
-[private] typedef struct utermlist_t_NODE termnode_t;

-[private] typedef struct {
	uterm_t *name;
	termnode_t *start,*end;
} tmpbinding_t;

-[ tbstack_t : private stack of tmpbinding_t *]

-[public] pflist_t *match_pattern
	(utermlist_t *pattern,utermlist_t *value)
{
	pflist_t *result;
	tbstack_t tbstack;

	tbstack_init(&tbstack);

	result= outer_match(pattern->head.next, &pattern->head,
		 value->head.next, &value->head, &tbstack);

	tbstack_destroy(&tbstack);

	return result;
}

-[private] pflist_t* outer_match
	(termnode_t *nD, termnode_t *D_head,
	termnode_t *nA, termnode_t *A_head,
	tbstack_t* tbstack)
{
	tmpbinding_t TB;
	termnode_t *X;
	pflist_t *collective_result=0;
	pflist_t *subresult;
	pflist_t *result= 0;
	uterm_t *D,*A;
again:
	if (nD==D_head) {
		result= tbstack_to_pflist(tbstack);
		goto done;
	}
	if (nA==A_head)
		/* no success, we already reached the end of
		the value without matching all of the pattern */
		return 0;

	D= nD->data;
	A= nA->data;

	switch(D->kind) {
		case ut_number:
		case ut_strlit:
		case ut_word:
		 	if (A->kind!=D->kind) return 0;
			if (strcmp(A->data,D->data)) return 0;
			nA= nA->next;
			nD= nD->next;
			goto again;
		case ut_ro_bulk:
		case ut_sq_bulk:
		case ut_cu_bulk:
			if (A->kind!=D->kind)
				return 0;
			subresult= match_inner_pattern
				(D->body, A->body);
			if (!subresult)
				return 0;
			if (collective_result)
				pflist_append_destructive
					(collective_result,subresult);
			else
				collective_result= subresult;
			nA= nA->next;
			nD= nD->next;
			goto again;
		case ut_macroarg:
			tbstack_push(tbstack, &TB);
			TB.name= D;
			TB.start= nA;
			for(X=nA;X!=A_head;X=X->next) {
				TB.end= X->next;
				result= outer_match(nD->next, D_head,
					  X->next, A_head, tbstack);
				if (result)
					goto success_noremove;
			}
			tbstack_pop(tbstack);
			return 0;
		case ut_smacroarg:
		case ut_nmacroarg:
		case ut_wmacroarg:
			if (A->kind!=actual_term_for_marg(D->kind))
				return 0;
			tbstack_push(tbstack, &TB);
			TB.name= D;
			TB.start= nA;
			TB.end= nA->next;
			result= outer_match(nD->next, D_head,
				  nA->next, A_head, tbstack);
			if (result)
				goto success_noremove;
			tbstack_pop(tbstack);
			return 0;
		default:
			*(int*)0=0;
	}

done:
	/* now remove the matched portion */
	if (result) {
		while(A_head->next!=nA) {
			termnode_t *X= A_head->next;
			-[ nlist>remove X ]
		}
		if (collective_result)
			pflist_append_destructive(result, collective_result);
	}
	return result;
success_noremove:
	if (collective_result)
		pflist_append_destructive(result, collective_result);
	return result;
}

-[ unused symbol tbstack_new ]
-[ unused symbol tbstack_isempty ]

-[private] pflist_t *match_inner_pattern
	(utermlist_t *pattern, utermlist_t *value)
{
	pflist_t *result;
	tbstack_t tbstack;
	tbstack_init(&tbstack);
	result= inner_match(pattern->head.next, &pattern->head,
		 value->head.next, &value->head, &tbstack);
	tbstack_destroy(&tbstack);
	return result;
}


-[private] pflist_t* inner_match
	(termnode_t *nD, termnode_t *D_head,
	termnode_t *nA, termnode_t *A_head,
	tbstack_t* tbstack)
{
	tmpbinding_t TB;
	termnode_t *X;
	pflist_t *collective_result=0;
	pflist_t *subresult;
	pflist_t *result= 0;
	uterm_t *D,*A;

again:
	if (nD==D_head || nA==A_head) {
		if (nD!=D_head || nA!=A_head) 
			return 0;
		result=  tbstack_to_pflist(tbstack);
		goto done;
	}
	D= nD->data;
	A= nA->data;

	switch(D->kind) {
		case ut_number:
		case ut_strlit:
		case ut_word:
		 	if (A->kind!=D->kind) return 0;
			if (strcmp(A->data,D->data)) return 0;
			nA= nA->next;
			nD= nD->next;
			goto again;
		case ut_ro_bulk:
		case ut_sq_bulk:
		case ut_cu_bulk:
			if (A->kind!=D->kind)
				return 0;
			subresult= match_inner_pattern
				(D->body, A->body);
			if (!subresult)
				return 0;
			if (collective_result)
				pflist_append_destructive
					(collective_result,subresult);
			else
				collective_result= subresult;
			nA= nA->next;
			nD= nD->next;
			goto again;
		case ut_macroarg:
			tbstack_push(tbstack, &TB);
			TB.name= D;
			TB.start= nA;
			for(X=nA;X!=A_head;X=X->next) {
				TB.end= X->next;
				result= inner_match(nD->next, D_head,
					  X->next, A_head, tbstack);
				if (result)
					goto done;
			}
			tbstack_pop(tbstack);
			return 0;
		case ut_smacroarg:
		case ut_nmacroarg:
		case ut_wmacroarg:
			if (A->kind!=actual_term_for_marg(D->kind))
				return 0;
			tbstack_push(tbstack, &TB);
			TB.name= D;
			TB.start= nA;
			TB.end= nA->next;
			result= inner_match(nD->next, D_head,
				  nA->next, A_head, tbstack);
			if (result)
				goto done;
			tbstack_pop(tbstack);
			return 0;
	}

done:
	if (result) {
		if (collective_result)
			pflist_append_destructive(result, collective_result);
	}
	return result;
}

-[private] pflist_t *tbstack_to_pflist(tbstack_t *stack)
{
	int i;
	pflist_t *R;
	R= pflist_new();
	for(i=stack->nelts-1;i>=0;i--) 
		pflist_append(R,tempbinding_to_pfunc(stack->elts[i]));
	return R;
}

-[private] pfunc_t *tempbinding_to_pfunc(tmpbinding_t *TB)
{
	pfunc_t *F;
	closure_t *C;
	utermlist_t *L;
	termnode_t *N;

	L= utermlist_new();
	for(N=TB->start;N!=TB->end;N=N->next)
		utermlist_append(L,N->data);

	-[ allocate object F ]
	F->kind= pfunc_builtin;
	F->name= strdup(TB->name->data);
	F->linenumber= TB->name->linenumber;

	C= closure_new(utermlist_const_closure);
	closure_set(C, "value", L);
	F->d.builtin= C;

	return F;
}


-[closure utermlist_const, begin]
	-[ closure is private ]
	-[ function is private ]
	-[ arg value : utermlist_t* ]
	-[ arg success : int* ]
	-[ arg parser : parser_t* ]
-[end] {
	operand_t A;
	*success= 1;
	A.kind= operand_utermlist;
	A.d.termlist= utermlist_deep_copy(value);
	astack_push(parser->astack, A);
}

-[private] enum uterm_kind actual_term_for_marg
	(enum uterm_kind K) 
{
	switch(K) {
	case ut_smacroarg: return ut_strlit;
	case ut_nmacroarg: return ut_number;
	case ut_wmacroarg: return ut_word;
	default:
		break;
	}
	*(int*)0= 0;
	return ut_number;
}

